unit labeller;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, Buttons, StdCtrls, Spin, Printers, OSPrinters, PrintersDlgs;

type

  TLabeltype = (ltNone, ltPrice, ltBarcodePrice);

  TLabelInfo = record
    labeltype: TLabeltype;
    count: integer;
    price: string;
    barcode: string;
    text: string[25];
  end;



  { TLabelPrinter }

   TLabelPrinter = class ( TObject )
   private
     FActive: Boolean;
     FFirstLabelIndex: Integer;
     FLastLabelIndex: Integer;
     FLabeltype: TLabeltype;
     FMaxLabels: Integer;
     fTopMargin: Integer;
     fLeftMargin: Integer;
     fHorzOffset: Integer;
     fVertOffset: Integer;
     fLabelListCount: integer;
     fLabelList: array of TLabelInfo;
     function GetFirstLabelIndex: Integer;
     function GetPrinterIndex: Integer;
     procedure SetLabeltype(const AValue: TLabeltype);
     procedure SetPrinterIndex ( const AValue: Integer ) ;
     procedure DoPrint( labelindex, startlabel: Integer );
     function Utf8Textwidth( txt: ansistring ): Integer;
   public
     function CM(Avalue: Double; VertRes:boolean=true): Integer;
     function MM(AValue: Double; VertRes:boolean=true): Integer;
     constructor Create;
     destructor Destroy; override;
     procedure Print;
     procedure PrintLabels( labelinfo: TLabelInfo; printfullsheet: Boolean=true);
     procedure CancelPrint;
     property TopMargin: Integer read fTopMargin write fTopMargin;
     property LeftMargin: Integer read fLeftMargin write fLeftMargin;
     property HorzOffset: Integer read fHorzOffset write fHorzOffset;
     property VertOffset: Integer read fVertOffset write fVertOffset;
     property Labeltype: TLabeltype read FLabeltype write SetLabeltype;
     property FirstLabelIndex: Integer read GetFirstLabelIndex write FFirstLabelIndex;
     property PrinterIndex: Integer read GetPrinterIndex write SetPrinterIndex;
     property MaxLabels: Integer read FMaxLabels;
     property Active: Boolean read FActive;
   end;


  { TPrintLabelDialog }

  TPrintLabelDialog = class(TForm)
    BarcodeEdit: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label7: TLabel;
    LabelTypeCombo: TComboBox;
    PrinterSetupDialog: TPrinterSetupDialog;
    FirstLabelEdit: TSpinEdit;
    TextCombo: TComboBox;
    PrinterCombo: TComboBox;
    FullSheetCheck: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ButtonPanel: TPanel;
    Label6: TLabel;
    PriceEdit: TEdit;
    PrinterButton: TButton;
    LabelcountEdit: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure LabelTypeComboChange(Sender: TObject);
    procedure PrinterButtonClick(Sender: TObject);
    procedure PrinterComboChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  PrintLabelDialog: TPrintLabelDialog;
  LabelPrinter: TLabelPrinter;

implementation
{ TLabelPrinter }

uses barcode;

function TLabelPrinter.GetPrinterIndex: Integer;
begin
  Result := Printer.PrinterIndex;
end;

function TLabelPrinter.GetFirstLabelIndex: Integer;
var
  x: integer;
  ct: integer;
begin
  ct := FFirstLabelIndex;
  for x := 0 to fLabelListCount-1 do
      ct := ct + fLabelList[x].count;
  Result := ct;
end;

procedure TLabelPrinter.SetLabeltype(const AValue: TLabeltype);
begin
  if FLabeltype = AValue then exit;
  FLabeltype := AValue;
  case AValue of
       ltPrice : fMaxLabels := 270;
       ltBarcodePrice: fMaxLabels := 80;
  end;
  FFirstLabelIndex := 1;
  FLastLabelIndex := 1;
end;

procedure TLabelPrinter.SetPrinterIndex ( const AValue: Integer ) ;
begin
  Printer.PrinterIndex := AValue;
end;

procedure TLabelPrinter.DoPrint(labelindex, startlabel: Integer);
var
  labelRect: TRect;
  leftside: LongInt;
  topline: LongInt;
  bottomline: Integer;
  pgh: Integer;
  pgw: Integer;
  rightside: Integer;
  r: Integer;
  c: Integer;
  thislabel: Integer;
  endlabel: Integer;
  fixedmarginleft: Integer;
  fixedmargintop: Integer;

  A, bmp: TBitmap;
  BC: TBarcode;
  price: String;
  pricewidth: LongInt;
  pricefontsize: Integer;
  maxpricewidth: Integer;
  priceheight: LongInt;
begin
  bmp := nil;
  endlabel := startlabel + fLabelList[labelindex].count-1;
  if endlabel>FMaxLabels
     then endlabel := FMaxLabels;
  thislabel := 0;

  fixedmarginleft :=(Printer.PaperSize.PaperRect.PhysicalRect.Right-Printer.PaperSize.PaperRect.PhysicalRect.Left - Printer.PageWidth) div 2;
  fixedmargintop := (Printer.PaperSize.PaperRect.PhysicalRect.Bottom-Printer.PaperSize.PaperRect.PhysicalRect.Top - Printer.PageHeight) div 2;
 // ShowMessage(IntToStr(fixedmarginleft)+ #32 + IntToStr(CM(1.0)));
 // Printer.FileName := '/tmp/test.ps';
  pgw := Printer.PageWidth-1;
  pgh := Printer.PageHeight-1;

  price := fLabelList[labelindex].price;
  pricefontsize := 15;
  Printer.Canvas.Font.Size := pricefontsize;
  Printer.Canvas.Font.Style := [fsBold];
  pricewidth := Utf8Textwidth(price);
  maxpricewidth := CM(1.2);
  writeln('pricewidth=', pricewidth, ' maxpricewidth=', maxpricewidth);
  while pricewidth > maxpricewidth do
        begin
          Dec(pricefontsize);
          Printer.Canvas.Font.Size := pricefontsize;
          pricewidth := Utf8Textwidth(price);
          writeln('pricewidth=', pricewidth, ' maxpricewidth=', maxpricewidth, ' fontsize=', pricefontsize);
        end;
  priceheight := Printer.Canvas.TextHeight(price);
  Printer.Canvas.Font.Style := [];
  Printer.Canvas.Font.Size := 7;

  case FLabeltype of
       ltPrice:         begin
                          topMargin := MM(12.5)-fixedmargintop;
                          leftMargin := MM(5) - fixedmarginleft;
                          labelRect := Rect(0, 0, MM(17.8), MM(10));
                          HorzOffset := MM(182) div 9;
                          VertOffset := MM(10.05);
                        end;
       ltBarcodePrice:  begin
                          topMargin := CM(1.3)-fixedmargintop;
                          leftMargin := CM(1.0)-fixedmarginleft;
                          labelRect := Rect(0, 0, CM(3.56), CM(1.69));
                          HorzOffset := CM(15.2) div 4;
                          VertOffset := CM(1.69);

                          //prepare barcode
                          BC := TBarcode.Create(Application);
                          A := TBitmap.Create;
                          A.Height := labelRect.Bottom - MM(6) - Printer.Canvas.TextHeight('Yy');
                          BC.Top := 0;
                          BC.Left := 0;
                          bc.Typ := bcCode128B;
                          bc.Modul := 8;
                          BC.Text := fLabelList[labelindex].barcode;
                          BC.Height := A.Height;
                          while BC.Width > (labelRect.Right-MM(3, false)-priceheight) do bc.Modul := bc.Modul-1;
                          A.Width := BC.Width;
                          //writeln('module: ', bc.Modul);
                          BC.DrawBarcode(A.Canvas);
                          bmp := TBitmap.Create;
                          bmp.Height := A.Height;
                          bmp.Width := A.Width;
                          if fLabelList[labelindex].barcode<>''
                             then bmp.Canvas.Draw(0, 0, A);
                          A.Free;
                        end;
  end;
  topline := topMargin;
  bottomline := topline + labelRect.Bottom;
  r := 0;
  Printer.Canvas.Font.Color:= clBlack;
  Printer.Canvas.Pen.Color:=clBlack;
  Printer.Canvas.Pen.Width := 3;

  while bottomline<pgh do
        begin
          c := 0;
          leftside := leftMargin;
          rightside := leftside + labelRect.Right;
          while rightside<pgw do
                begin
                  Inc(thislabel);
                  if (thislabel>=startlabel) and (thislabel<=endlabel) then
                     begin
                       //Printer.Canvas.Rectangle(leftside, topline, rightside, bottomline);
                       case FLabeltype of
                            ltPrice: begin
                                       Printer.Canvas.Font.Style := [fsBold];
                                       Printer.Canvas.Font.Size := pricefontsize;
                                       Printer.Canvas.Font.Orientation := 0;
                                       Printer.Canvas.TextOut(leftside + MM(2), topline + MM(2), price);
                                     end;
                            ltBarcodePrice:
                                     begin
                                       Printer.Canvas.Draw(leftside + MM(3), bottomline- MM(3) - bmp.Height, bmp);
                                       Printer.Canvas.Font.Style := [];
                                       Printer.Canvas.Font.Size := 7;
                                       Printer.Canvas.Font.Orientation := 0;
                                       Printer.Canvas.TextOut(leftside + MM(3), topline + MM(2), fLabelList[labelindex].text);
                                       Printer.Canvas.Font.Style := [fsBold];
                                       Printer.Canvas.Font.Size := pricefontsize;
                                       Printer.Canvas.Font.Orientation := -900;
                                       Printer.Canvas.TextOut(rightside - MM(1) - priceheight, bottomline - priceheight- pricewidth -MM(3), price);
                                     end;
                       end;
                     end;
                  Inc(c);
                  leftside := leftMargin + (HorzOffset*c);
                  rightside := leftside + labelRect.Right;
                end;
          Inc(r);
          topline := topMargin + (VertOffset*r);
          bottomline := topline + labelRect.Bottom;
        end;
  if Assigned(bmp)
     then bmp.Free;
end;

function TLabelPrinter.Utf8Textwidth(txt: ansistring): Integer;
var
  x: Integer;
begin
  for x := Length(txt) downto 1 do
      if txt[x] in [#194..#201]  //covers Latin character sets
         then Delete(txt, x, 1);
  Result := Printer.Canvas.TextWidth(txt);
end;

function TLabelPrinter.CM(Avalue: Double; VertRes: boolean): Integer;
begin
  result := MM(AValue*10, vertRes);
end;

function TLabelPrinter.MM(AValue: Double; VertRes: boolean): Integer;
begin
  if VertRes then
    result := Round(AValue*Printer.YDPI/25.4)
  else
    result := Round(AValue*Printer.XDPI/25.4);
end;

constructor TLabelPrinter.Create;
var
  x: Integer;
begin
  FActive := false;
  fLabelListCount := 0;
  FFirstLabelIndex := 0;
  FLastLabelIndex := 0;
  SetLength(fLabelList, 20);
  for x := 0 to 19 do fLabelList[x].count := 0;
end;

destructor TLabelPrinter.Destroy;
begin
  Printer.Free;
  inherited Destroy;
end;

procedure TLabelPrinter.Print;
var
  x: Integer;
begin
  try
  Printer.Title := 'FireMan labels';
  Printer.BeginDoc;
  for x := 0 to fLabelListCount-1 do
      begin
        DoPrint(x, FFirstLabelIndex);
        FFirstLabelIndex := FFirstLabelIndex + fLabelList[x].count;
      end;
  Printer.EndDoc;

  if FFirstLabelIndex>MaxLabels then
     begin
       fLabelList[x].count := FFirstLabelIndex-MaxLabels;
       ShowMessage('Remaining labels: ' + IntToStr(fLabelList[x].count));
       FFirstLabelIndex := 1;
       FLastLabelIndex := fLabelList[x].count;
       fLabelList[0] := fLabelList[x];
       fLabelListCount := 1;
       FActive := true;
     end
  else
     begin
       fLabelListCount := 0;
       FActive := false;
       FFirstLabelIndex := 1;
       FLastLabelIndex := 1;
     end;

  except
     on E : Exception do
        begin
          writeln('Error when printing labels: ', E.ClassName, #32, E.Message);
          ShowMessage(E.ClassName + LineEnding + E.Message);
        end;

  end;
end;

procedure TLabelPrinter.PrintLabels(labelinfo: TLabelInfo;
  printfullsheet: Boolean);
begin
  if fLabelListCount>=Length(fLabelList)
     then SetLength(fLabelList, fLabelListCount + 5);
  fLabelList[fLabelListCount] := labelinfo;
  Inc(fLabelListCount);
  FLastLabelIndex := FLastLabelIndex + labelinfo.count;
  if printfullsheet then
     begin
       if FLastLabelIndex>=FMaxLabels
          then Print
       else FActive := true;
     end
  else Print;
end;

procedure TLabelPrinter.CancelPrint;
begin
  fActive := false;
  fLabelListCount := 0;
  FFirstLabelIndex := 1;
  FLastLabelIndex := 1;
end;

{ TPrintLabelDialog }

procedure TPrintLabelDialog.FormCreate(Sender: TObject);
var
  x: Integer;
begin
  if Printer.Printers.Count>0 then
  begin
    PrinterCombo.Items.Clear;
    For x := 0 to Printer.Printers.Count-1 do
        PrinterCombo.Items.Add(Printer.Printers[x]);
    if Printer.PrinterIndex<0
       then Printer.PrinterIndex := 0;
     PrinterCombo.ItemIndex := Printer.PrinterIndex
   end;
  LabelPrinter := TLabelPrinter.Create;
end;

procedure TPrintLabelDialog.LabelTypeComboChange(Sender: TObject);
var
  x: Integer;
begin
  if LabelTypeCombo.ItemIndex<0 then exit;
  case LabelTypeCombo.ItemIndex of
       0: begin
            FirstLabelEdit.MaxValue := 270;
            for x := 0 to ComponentCount-1 do
                if TComponent(Components[x]).Tag=1
                   then TWinControl(Components[x]).Enabled := false;
          end;
       1: begin
            FirstLabelEdit.MaxValue := 80;
            for x := 0 to ComponentCount-1 do
                if TComponent(Components[x]).Tag=1
                   then TWinControl(Components[x]).Enabled := true;
          end;
  end;
end;

procedure TPrintLabelDialog.PrinterButtonClick(Sender: TObject);
begin
  PrinterSetupDialog.Execute;
end;

procedure TPrintLabelDialog.PrinterComboChange(Sender: TObject);
begin
  Printer.PrinterIndex := PrinterCombo.ItemIndex;
end;

initialization
{$I labeller.lrs}

end.

